home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1996 #3
/
Amiga Plus CD - 1996 - No. 3.iso
/
demo-versionen
/
databaseprofessional_v3.0
/
picbase
/
picturebase.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-12-29
|
9KB
|
353 lines
/* PictureBase, Bildverwaltung mit DataBase Professional, 10.08.95, Jörg Richter */
OPTIONS RESULTS
RenderScreen = "Amiga 167936 640 256 256"
/* dispID x y colors */
DIAsize = 120 /* Vorschaugröße */
TempDefaults = "T:ADPro.defaults"
NL = D2C(10)
device = "CON:0/0/640/200/Information/WAIT/CLOSE/SCREENDataBase"
ADDRESS DataBase DBTOFRONT
ADDRESS COMMAND
'C:Requestfile > ENV:picpath DRAWERSONLY TITLE="Quellpfad der Bilder" NOICONS PUBSCREEN DataBase'
IF RC = 0 THEN DO
'C:Requestfile > ENV:thumb DRAWER DBPRO:PicBase DRAWERSONLY TITLE="Pfad für Vorschaubilder" NOICONS PUBSCREEN DataBase'
IF RC = 0 THEN DO
'Echo > ENV:thumbpath $thumb'
'Echo > ENV:source $picpath'
ADDRESS DataBase RequestText "Datei-Muster ~(#?.info)"
IF result = "" THEN
'Echo > ENV:patt ~(#?.info)'
ELSE
'Echo > ENV:patt ' || result
ADDRESS DataBase Message "Erzeuge Verzeichnisstruktur für Vorschaubilder ..."
'List > T:script $picpath dirs all lformat="$source %p%n $thumbpath"'
CALL MakeDirs
ADDRESS DataBase Message "Scanne Quellpfad der Bilder ..."
'List > T:script $picpath P=$patt files all lformat="$thumbpath $source %p%n %l"'
ADDRESS DataBase
Request "_Ja|_Nein|_Abbruch" "Haben Sie ADPro installiert ?" || NL || NL || "(Ansonsten wird das PBMplus Paket verwendet.)"
adpro = RC
IF adpro = 0 THEN EXIT
IF adpro = 1 THEN DO
Request "_IFF|_GIF|_Abbruch" "*** ADPro starten ***" || NL || NL || "Format für die Vorschaubilder ?"
IF RC > 0 THEN DO
IF RC = 1 THEN
saveop = "IFF"
ELSE
saveop = "GIF"
CALL PicBase
END
END /* DO */
ELSE DO
Request "_Farben|_Graustufen|_Abbruch" "Vorschaubilder in 256 Farben oder 16 Graustufen umrechnen ?"
colop = RC
IF colop > 0 THEN DO
colop = RC
CALL PicBasePBM
END
END /* DO */
ADDRESS DataBase DBTOFRONT
ADDRESS COMMAND
'C:Delete > NIL: T:script'
END
END
EXIT
MakeDirs:
ok = Open(file,'ENV:thumbpath',R)
dest = ReadLn(file)
'C:MakeDir > NIL: ' || LEFT(dest,Length(dest)-1)
ok = Close(file)
ok = Open(file,"T:script",R)
IF ok THEN DO
weiter = 0
DO WHILE weiter = 0
str = ReadLn(file)
IF Length(str) > 0 THEN DO
PARSE VAR str source dir dest .
dir = DelStr(dir,1,Length(source))
'C:MakeDir > NIL: ' dest || dir
END
weiter = EOF(file)
END
ok = Close(file)
END
RETURN
PicBase:
weiter = 0
DO WHILE weiter = 0
weiter = Show('P','ADPro')
IF weiter = 0 THEN DO
ADDRESS DataBase
Request "_Gestartet|_Abbruch" "Bitte ADPro starten ..."
IF RC = 0 THEN EXIT
ADDRESS
END
END
ok = Open(file,"T:script",R)
IF ok THEN DO
ADDRESS "ADPro" SAVE_DEFAULTS TempDefaults
ok = Open(out,device,W)
cnt = WriteLn(out,"Start : " || TIME())
reset = TIME(r)
weiter = 0
DO WHILE weiter = 0
str = ReadLn(file)
IF Length(str) > 0 THEN
CALL CreateThumb
weiter = EOF(file)
END
ok = Close(file)
ADDRESS "ADPro" LOAD_DEFAULTS TempDefaults
cnt = WriteLn(out,"Finish: " || TIME())
cnt = WriteLn(out,D2C(10) || "Convertion time (s): " || TIME(e))
ok = Close(out)
END
RETURN
CreateThumb:
PARSE VAR str path source bild length .
/*
path = Pfad für das erzeugte Thumbnail
source = Quellpfad der Bilder
bild = Pfad und Name des eigentlichenen Bildes
length = Dateilänge des Bildes
*/
IF RIGHT(path,1) ~= "/" THEN DO
IF RIGHT(path,1) ~= ":" THEN
path = path || "/"
END
path = path || DelStr(bild,1,Length(source))
pos = MAX(LastPos("/",bild),LastPos(":",bild))+1
bildname = SubStr(bild,pos,Length(bild)-pos+1) /* Bildname ermitteln */
pos = LastPos(".",bildname)
IF pos > 0 THEN
bildname = LEFT(bildname,pos) || saveop
path = SubStr(path,1,Length(path)-Length(bildname))
IF Exists(path || bildname) = 1 THEN DO /* Falls Thumbnail schon existiert */
cnt = WriteLn(out,"Skipping: " || bild || " exists")
RETURN /* weiter mit nächsten Bild */
END
ADDRESS DataBase Message "Bearbeite " || bild || " ..."
ADDRESS "ADPro"
PSTATUS "LOCKED"
DITHER 1
IF Compare(RIGHT(bild,4),".PCD") = 0 THEN DO
ADDRESS COMMAND
'DBPRO:PicBase/PBMbin/hpcdtoppm > JPEGTMP:t.ppm -2 ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Loading error: " || bild)
RETURN
END
ADDRESS "ADPro"
LOADER "PNM" "JPEGTMP:t.ppm"
END
ELSE DO
pcd = 0
LOADER "UNIVERSAL" bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Loading error: " || bild)
RETURN
END
END
XSIZE
width = ADPRO_RESULT
YSIZE
height = ADPRO_RESULT
IF width > height THEN DO
yy = (height/width) * DIAsize
xx = DIAsize
END
ELSE DO
xx = (width/height) * DIAsize
yy = DIAsize
END
ABS_SCALE xx yy
SET_RENDER_MODE RenderScreen
EXECUTE
SAVER saveop path || bildname "IMAGE"
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Saving error : " || path || bildname)
RETURN
END
ADDRESS DataBase
Add
PutData $F1 bild
PutData $F2 length
PutData $F3 width || "x" || height
IF Compare(LEFT(path,6),"DBPRO:") = 0 THEN path = DelStr(path,1,6)
PutData $F4 path || bildname
RETURN
/* PBM Script */
PicBasePBM:
ok = Open(sfile,"T:script",R)
IF ok THEN DO
ok = Open(out,device,W)
cnt = WriteLn(out,"Start : " || TIME())
reset = TIME(r)
weiter = 0
DO WHILE weiter = 0
str = ReadLn(sfile)
IF Length(str) > 0 THEN
CALL CreateThumbPBM
weiter = EOF(sfile)
END
ok = Close(sfile)
cnt = WriteLn(out,"Finish: " || TIME())
cnt = WriteLn(out,D2C(10) || "Convertion time (s): " || TIME(e))
ok = Close(out)
END
RETURN
CreateThumbPBM:
PARSE VAR str path source bild length .
/*
path = Pfad für das erzeugte Thumbnail
source = Quellpfad der Bilder
bild = Pfad und Name des eigentlichenen Bildes
length = Dateilänge des Bildes
*/
IF RIGHT(path,1) ~= "/" THEN DO
IF RIGHT(path,1) ~= ":" THEN
path = path || "/"
END
path = path || DelStr(bild,1,Length(source))
pos = MAX(LastPos("/",bild),LastPos(":",bild))+1
bildname = SubStr(bild,pos,Length(bild)-pos+1) /* Bildname ermitteln */
pos = LastPos(".",bildname)
IF pos > 0 THEN
bildname = LEFT(bildname,pos) || "iff"
path = SubStr(path,1,Length(path)-Length(bildname))
IF Exists(path || bildname) = 1 THEN DO /* Falls Thumbnail schon existiert */
cnt = WriteLn(out,"Skipping: " || bild || " exists")
RETURN /* weiter mit nächsten Bild */
END
ADDRESS DataBase Message "Bearbeite " || bild || " ..."
ADDRESS COMMAND
'DBPRO:PicBase/PBMbin/filetype ' || bild
type = RC
IF type >= 6 THEN DO
IF Compare(RIGHT(bild,4),".PCD") = 0 THEN DO
'DBPRO:PicBase/PBMbin/hpcdtoppm > JPEGTMP:t.ppm -2 ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading PCD: " || bild)
RETURN
END
END
ELSE DO
cnt = WriteLn(out,"*** Error loading: " || bild)
cnt = WriteLn(out,"*** Supported formats: IFF, JPEG, GIF, PCX, BMP, TIFF, PhotoCD")
RETURN
END
END
IF type = 0 THEN DO
'DBPRO:PicBase/PBMbin/ilbmtoppm > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading ILBM: " || bild)
RETURN
END
END
IF type = 1 THEN DO
'DBPro:PicBase/PBMBIN/giftopnm > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading GIF: " || bild)
RETURN
END
END
IF type = 2 THEN DO
'DBPRO:PicBase/PBMBIN/Djpeg > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading JPEG: " || bild)
RETURN
END
END
IF type = 3 THEN DO
'DBPro:PicBase/PBMBIN/bmptoppm > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading BMP: " || bild)
RETURN
END
END
IF type = 4 THEN DO
'DBPro:PicBase/PBMBIN/pcxtoppm > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading PCX: " || bild)
RETURN
END
END
IF type = 5 THEN DO
'DBPro:PicBase/PBMBIN/tifftopnm > JPEGTMP:t.ppm ' || bild
IF RC ~= 0 THEN DO
cnt = WriteLn(out,"Error loading TIFF: " || bild)
RETURN
END
END
ADDRESS
bool = Open(file,'JPEGTMP:t.ppm',R)
str = ReadLn(file)
str = ReadLn(file)
width = WORD(str,1)
height = WORD(str,2)
bool = Close(file)
ADDRESS COMMAND
'DBPRO:PicBase/PBMBIN/pnmscale > JPEGTMP:s.ppm -xysize ' || DIAsize || ' ' || DIAsize || ' JPEGTMP:t.ppm'
'C:Delete > NIL: JPEGTMP:t.ppm'
IF colop = 1 THEN
'DBPRO:PicBase/PBMBIN/ppmtoilbm > ' || path || bildname || ' -fs -mp 8 -map DBPRO:PicBase/PBMBIN/cmap.ppm JPEGTMP:s.ppm'
ELSE
'DBPRO:PicBase/PBMBIN/ppmtoilbm > ' || path || bildname || ' -fs -mp 4 -map DBPRO:PicBase/PBMBIN/gmap.ppm JPEGTMP:s.ppm'
'C:Delete > NIL: JPEGTMP:s.ppm'
ADDRESS DataBase
Add
PutData $F1 bild
PutData $F2 length
PutData $F3 width || "x" || height
IF Compare(LEFT(path,6),"DBPRO:") = 0 THEN path = DelStr(path,1,6)
PutData $F4 path || bildname
RETURN